home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 March / EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso / earcd / gnu / gnpltsrc.lha / vms.c < prev    next >
C/C++ Source or Header  |  1996-01-22  |  6KB  |  232 lines
  1. #ifndef lint
  2. static char    *RCSid = "$Id: vms.c,v 1.2 1995/03/31 13:24:29 drd Exp $";
  3. #endif
  4.  
  5. /* drop in popen() / pclose() for VMS
  6.  * originally written for port of perl to vms
  7.  */
  8.  
  9. static int something_in_this_file;
  10.  
  11. #ifdef PIPES
  12.  
  13. /* (to aid porting) - how are errors dealt with */
  14.  
  15. #define ERROR(msg) { fprintf(stderr, "%s\nFile %s line %d\n", msg, __FILE__, __LINE__); }
  16. #define FATAL(msg) { fprintf(stderr, "%s\nFile %s line %d\n", msg, __FILE__, __LINE__); exit(EXIT_FAILURE); }
  17.  
  18.  
  19. #include <stdio.h>
  20. #include <stdlib.h>
  21. #include <string.h>
  22.  
  23. #include <dvidef.h>
  24. #include <syidef.h>
  25. #include <jpidef.h>
  26. #include <ssdef.h>
  27. #include <descrip.h>
  28.  
  29. /*cant be bothered finding which include files define these */
  30. int lib$getsyi();
  31. int sys$crembx();
  32. int lib$getdvi();
  33. int sys$hiber();
  34. int sys$schdwk();
  35. int sys$wake();
  36. int sys$dassgn();
  37. int lib$spawn();
  38. int sys$forcex();
  39. int sys$delprc();
  40. int lib$getjpi();
  41. int sys$bintim();
  42.  
  43.  
  44. #define _cksts(call) \
  45.   if (!(sts=(call))&1) FATAL("Internal error") else {}
  46.  
  47. static void
  48. create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
  49. {
  50.     static unsigned long int mbxbufsiz;
  51.         long int syiitm = SYI$_MAXBUF, dviitm = DVI$_DEVNAM;
  52.     unsigned long sts;  /* for _cksts */
  53.   
  54.   if (!mbxbufsiz) {
  55.     /*
  56.      * Get the SYSGEN parameter MAXBUF, and the smaller of it and the
  57.      * preprocessor consant BUFSIZ from stdio.h as the size of the
  58.      * 'pipe' mailbox.
  59.      */
  60.  
  61.     _cksts(lib$getsyi(&syiitm, &mbxbufsiz, 0, 0, 0, 0));
  62.     if (mbxbufsiz > BUFSIZ) mbxbufsiz = BUFSIZ; 
  63.   }
  64.   _cksts(sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
  65.  
  66.   _cksts(lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length));
  67.   namdsc->dsc$a_pointer[namdsc->dsc$w_length] = '\0';
  68.  
  69. }  /* end of create_mbx() */
  70.  
  71. struct pipe_details
  72. {
  73.     struct pipe_details *next;
  74.     FILE *fp;
  75.     int pid;
  76.     unsigned long int completion;
  77. };
  78.  
  79. static struct pipe_details *open_pipes = NULL;
  80. static $DESCRIPTOR(nl_desc, "NL:");
  81. static int waitpid_asleep = 0;
  82.  
  83. static void
  84. popen_completion_ast(unsigned long int unused)
  85. {
  86.   if (waitpid_asleep) {
  87.     waitpid_asleep = 0;
  88.     sys$wake(0,0);
  89.   }
  90. }
  91.  
  92. FILE *
  93. popen(char *cmd, char *mode)
  94. {
  95.     char mbxname[64];
  96.     unsigned short int chan;
  97.     unsigned long int flags=1;  /* nowait - gnu c doesn't allow &1 */
  98.     struct pipe_details *info;
  99.     struct dsc$descriptor_s namdsc = {sizeof mbxname, DSC$K_DTYPE_T,
  100.                                       DSC$K_CLASS_S, mbxname},
  101.                             cmddsc = {0, DSC$K_DTYPE_T,
  102.                                       DSC$K_CLASS_S, 0};
  103.     unsigned long sts;                            
  104.  
  105.     if (!(info=malloc(sizeof(struct pipe_details))))
  106.     {
  107.         ERROR("Cannot malloc space");
  108.         return NULL;
  109.     }
  110.  
  111.     info->completion=0;  /* I assume this will remain 0 until terminates */
  112.         
  113.     /* create mailbox */
  114.     create_mbx(&chan,&namdsc);
  115.  
  116.     /* open a FILE* onto it */
  117.     info->fp=fopen(mbxname, mode);
  118.  
  119.     /* give up other channel onto it */
  120.     _cksts(sys$dassgn(chan));
  121.  
  122.     if (!info->fp)
  123.         return NULL;
  124.         
  125.     cmddsc.dsc$w_length=strlen(cmd);
  126.     cmddsc.dsc$a_pointer=cmd;
  127.  
  128.     if (strcmp(mode,"r")==0) {
  129.       _cksts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags,
  130.                      0  /* name */, &info->pid, &info->completion,
  131.                      0, popen_completion_ast,0,0,0,0));
  132.     }
  133.     else {
  134.       _cksts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */, &flags,
  135.                      0  /* name */, &info->pid, &info->completion));
  136.     }
  137.  
  138.     info->next=open_pipes;  /* prepend to list */
  139.     open_pipes=info;
  140.         
  141.     return info->fp;
  142. }
  143.  
  144. int pclose(FILE *fp)
  145. {
  146.     struct pipe_details *info, *last = NULL;
  147.     unsigned long int abort = SS$_TIMEOUT, retsts;
  148.     unsigned long sts;
  149.     
  150.     for (info = open_pipes; info != NULL; last = info, info = info->next)
  151.         if (info->fp == fp) break;
  152.  
  153.     if (info == NULL)
  154.       /* get here => no such pipe open */
  155.       FATAL("pclose() - no such pipe open ???");
  156.  
  157.     if (!info->completion) { /* Tap them gently on the shoulder . . .*/
  158.       _cksts(sys$forcex(&info->pid,0,&abort));
  159.       sleep(1);
  160.     }
  161.     if (!info->completion)  /* We tried to be nice . . . */
  162.       _cksts(sys$delprc(&info->pid));
  163.     
  164.     fclose(info->fp);
  165.     /* remove from list of open pipes */
  166.     if (last) last->next = info->next;
  167.     else open_pipes = info->next;
  168.     retsts = info->completion;
  169.     free(info);
  170.  
  171.     return retsts;
  172. }  /* end of pclose() */
  173.  
  174.  
  175. /* sort-of waitpid; use only with popen() */
  176. /*{{{unsigned long int waitpid(unsigned long int pid, int *statusp, int flags)*/
  177. unsigned long int
  178. waitpid(unsigned long int pid, int *statusp, int flags)
  179. {
  180.     struct pipe_details *info;
  181.     unsigned long int abort = SS$_TIMEOUT;
  182.     unsigned long sts;
  183.     
  184.     for (info = open_pipes; info != NULL; info = info->next)
  185.         if (info->pid == pid) break;
  186.  
  187.     if (info != NULL) {  /* we know about this child */
  188.       while (!info->completion) {
  189.         waitpid_asleep = 1;
  190.         sys$hiber();
  191.       }
  192.  
  193.       *statusp = info->completion;
  194.       return pid;
  195.     }
  196.     else {  /* we haven't heard of this child */
  197.       $DESCRIPTOR(intdsc,"0 00:00:01");
  198.       unsigned long int ownercode = JPI$_OWNER, ownerpid, mypid;
  199.       unsigned long int interval[2];
  200.  
  201.       _cksts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
  202.       _cksts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
  203.       if (ownerpid != mypid)
  204.         FATAL("pid not a child");
  205.  
  206.       _cksts(sys$bintim(&intdsc,interval));
  207.       while ((sts=lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)) & 1) {
  208.         _cksts(sys$schdwk(0,0,interval,0));
  209.         _cksts(sys$hiber());
  210.       }
  211.       _cksts(sts);
  212.  
  213.       /* There's no easy way to find the termination status a child we're
  214.        * not aware of beforehand.  If we're really interested in the future,
  215.        * we can go looking for a termination mailbox, or chase after the
  216.        * accounting record for the process.
  217.        */
  218.       *statusp = 0;
  219.       return pid;
  220.     }
  221.                     
  222. }  /* end of waitpid() */
  223.  
  224. #endif /* PIPES */
  225.  
  226.  
  227. /* vax c doesn't come with strftime - watch out for redefn of RCSid */
  228. #ifdef VAXCRTL
  229. # define RCSid RCSid2
  230. # include "strftime.c"
  231. #endif
  232.